QBasic & Borland Pascal & C/Delphi5.iso/Basic/Visual Basic.60/VB98/WIZARDS/PDWIZARD/SETUP1/GROUP.FRM

Visual Basic Form | 1998-06-18 | 10.6 KB | 335 lines

VERSION 5.00
Begin VB.Form frmGroup
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "* #"
   ClientHeight    =   5250
   ClientLeft      =   1095
   ClientTop       =   1515
   ClientWidth     =   5460
   Icon            =   "group.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   350
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   364
   Begin VB.DirListBox dir95Groups
      Height          =   930
      Left            =   765
      TabIndex        =   8
      Top             =   60
      Visible         =   0   'False
      Width           =   3810
   End
   Begin VB.Frame Frame1
      Height          =   30
      Left            =   105
      TabIndex        =   7
      Top             =   4650
      Width           =   5220
   End
   Begin VB.CommandButton cmdCancel
      Cancel          =   -1  'True
      Caption         =   "#"
      Height          =   345
      Left            =   2880
      MaskColor       =   &H00000000&
      TabIndex        =   3
      Top             =   4800
      Width           =   1140
   End
   Begin VB.CommandButton cmdContinue
      Caption         =   "#"
      Default         =   -1  'True
      Height          =   345
      Left            =   1395
      MaskColor       =   &H00000000&
      TabIndex        =   2
      Top             =   4800
      Width           =   1140
   End
   Begin VB.ListBox lstGroups
      Height          =   2010
      ItemData        =   "group.frx":0442
      Left            =   1080
      List            =   "group.frx":0449
      Sorted          =   -1  'True
      TabIndex        =   1
      Top             =   2220
      Width           =   3240
   End
   Begin VB.TextBox txtGroup
      Height          =   300
      Left            =   1080
      TabIndex        =   0
      Text            =   "*"
      Top             =   1410
      Width           =   3270
   End
   Begin VB.Label lblDDE
      Height          =   225
      Left            =   225
      TabIndex        =   9
      Top             =   1350
      Visible         =   0   'False
      Width           =   705
   End
   Begin VB.Label lblGroups
      AutoSize        =   -1  'True
      Caption         =   "#"
      Height          =   195
      Left            =   1080
      TabIndex        =   6
      Top             =   1950
      Width           =   105
   End
   Begin VB.Label lblGroup
      AutoSize        =   -1  'True
      Caption         =   "#"
      Height          =   195
      Left            =   1080
      TabIndex        =   5
      Top             =   1170
      Width           =   105
   End
   Begin VB.Label lblMain
      AutoSize        =   -1  'True
      Caption         =   "#"
      Height          =   195
      Left            =   180
      TabIndex        =   4
      Top             =   165
      Width           =   5100
      WordWrap        =   -1  'True
   End
Attribute VB_Name = "frmGroup"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim mstrGroup As String
Dim mstrDefGroup As String
Dim mstrProgramsPath As String
Dim mfrm As Form
Dim fPrivate As Boolean
Dim fStartMenu As Boolean
Private Sub cmdCancel_Click()
    ExitSetup frmGroup, gintRET_EXIT
End Sub
Private Sub cmdContinue_Click()
    mstrGroup = txtGroup.Text
    If Not fCreateProgGroup() Then
        '
        ' Couldn't create the group. Let
        ' the user try again.
        '
        txtGroup.SetFocus
    Else
        '
        ' The group got created ok, so unload Choose Program Group dialog
        ' and continue on with setup.
        '
        Unload Me
    End If
End Sub
Private Function fCreateProgGroup() As Boolean
' Create a program group for either NT or Win95.
    Dim strMsg As String
    If TreatAsWin95() Then
        If Not fValidFilename(mstrGroup) Then
            strMsg = ResolveResString(resGROUPINVALIDGROUPNAME, "|1", CStr(gintMAX_PATH_LEN), "|2", ResolveResString(resCOMMON_INVALIDFILECHARS))
            MsgFunc strMsg, vbOKOnly Or vbQuestion, gstrTitle
            GoTo CGError
        End If
    Else
        If Not fValidNTGroupName(mstrGroup) Then
            strMsg = ResolveResString(resGROUPINVALIDGROUPNAME, "|1", CStr(gintMAX_GROUPNAME_LEN%), "|2", ResolveResString(resGROUPINVALIDCHARS))
            MsgFunc strMsg, vbOKOnly Or vbQuestion, gstrTitle
            GoTo CGError
        End If

    End If
    '
    'Go ahead and create the main program group
    '
    If Not fCreateOSProgramGroup(mfrm, mstrGroup, True, , fPrivate, fStartMenu) Then
        GoTo CGError
    End If
    fCreateProgGroup = True
    Exit Function
CGError:
    fCreateProgGroup = False
End Function
Private Sub Form_Load()
    '
    ' Initialize localized control properties.
    '
    SetFormFont Me
    Me.Caption = ResolveResString(resGROUPFRM, "|1", gstrAppName)
    lblMain.Caption = ResolveResString(resGROUPLBLMAIN)
    lblGroup.Caption = ResolveResString(resGROUPLBLGROUP)
    lblGroups.Caption = ResolveResString(resGROUPLBLGROUPS)
    cmdContinue.Caption = ResolveResString(resGROUPBTNCONTINUE)
    cmdCancel.Caption = ResolveResString(resLOG_vbCancel)
    '
    ' Initialize the Program Group text box with the
    ' title of the application.
    '
    txtGroup.Text = gstrTitle
    '
    ' Load the ListBox with the program manager groups.
    '
    If TreatAsWin95() Then
        LoadW95Groups
    Else
        LoadProgManGroups
    End If
    '
    ' Initialize the Program Group textbox with the
    ' default group selected in the list box.
    '
    txtGroup.Text = lstGroups.List(lstGroups.ListIndex)
End Sub
Private Sub lstGroups_Click()
    txtGroup.Text = lstGroups.List(lstGroups.ListIndex)
End Sub
Private Sub txtGroup_Change()
    cmdContinue.Enabled = Len(Trim(txtGroup.Text)) > 0
End Sub
Sub LoadProgManGroups()
' This routine uses DDE to talk to Program Manager
' to retrieve a list of all the groups it manages.
' It should only be called if the shell is NT 3.51.
' If it is Win95 or NT4, call LoadW95Groups()
' instead.
' Special strings used in this routine.  Do not
' localize these strings.
    Const strPROGMANLINKTOPIC = "ProgMan|Progman"
    Const strPROGMANLINKITEM = "Progman"
    Const strNDWGROUP = "Quick Access"
    Dim strGroups As String
    Dim strGroup As String
    Dim intOffset As Integer
    Dim intAnchor As Integer
    Dim iGroup As Long
    lblDDE.LinkTopic = strPROGMANLINKTOPIC
    lblDDE.LinkItem = strPROGMANLINKITEM
    lblDDE.LinkMode = 2
    lblDDE.LinkRequest
    On Error Resume Next
    lblDDE.LinkMode = 0
    '
    ' The DDE call just made put the names of all the groups
    ' into the caption property of the lblDDE control.
    ' We want to transfer them to the list box.  They are
    ' separated by vbcrlf's.
    '
    strGroups = lblDDE.Caption
    intAnchor = 1
    intOffset = InStr(intAnchor, strGroups, vbCrLf)
    lstGroups.Clear
    Do While intOffset > 0
        strGroup = Mid(strGroups, intAnchor, intOffset - intAnchor)
        '
        ' Norton Desktop for Windows uses the "Quick Access" group
        ' to replace program manager.  Trying to add icons to this
        ' group will fail later when we perform our DDE.linkrequest.
        ' Therefore, skip this group.
        '
        If strGroup <> strNDWGROUP Then
            lstGroups.AddItem strGroup
        End If

        intAnchor = intOffset + 2
        intOffset = InStr(intAnchor, strGroups, vbCrLf)
    Loop
    '
    ' The lstGroups listbox now contains a listing of all the program
    ' manager groups.
    '
    ' Look for the default group in the list and select it.  If it's
    ' not there, add it.
    '
    iGroup = SendMessageString(lstGroups.hwnd, LB_FINDSTRINGEXACT, -1, mstrDefGroup)
    If iGroup = LB_ERR Then
        '
        ' The group doesn't yet exist, add it to the list.
        '
        lstGroups.AddItem mstrDefGroup
        lstGroups.ListIndex = lstGroups.NewIndex
    Else
        lstGroups.ListIndex = iGroup
    End If
End Sub
Sub LoadW95Groups()
' This routine uses the system registry to
' retrieve a list of all the subfolders in the
' \windows\start menu\programs folder.
' It should only be called if the shell is Win95
' NT4.  If it is NT 3.51, call LoadProgManGroups()
' instead.
    Dim strFolder As String
    Dim iFolder As Integer
    mstrProgramsPath = strGetProgramsFilesPath()
    strFolder = Dir(mstrProgramsPath, vbDirectory)   ' Retrieve the first entry.
    lstGroups.Clear
    Do While strFolder <> ""
        '
        ' Ignore the current directory and the encompassing directory.
        '
        If strFolder <> "." And strFolder <> ".." Then
            '
            ' Verify that we actually got a directory and not a file.
            '
            If (GetAttr(mstrProgramsPath & strFolder) And vbDirectory) = vbDirectory Then
                '
                ' We got a directory, add it to the list.
                '
                lstGroups.AddItem strFolder
            End If
        End If
        '
        ' Get the next subfolder in the Programs folder
        '
        strFolder = Dir
    Loop
    '
    ' The lstGroups listbox now contains a listing of all the Programs
    ' subfolders (the groups).
    '
    ' Look for the default folder in the list and select it.  If it's
    ' not there, add it.
    '
    iFolder = SendMessageString(lstGroups.hwnd, LB_FINDSTRINGEXACT, -1, mstrDefGroup)
    If iFolder = LB_ERR Then
        '
        ' The group doesn't yet exist, add it to the list.
        '
        lstGroups.AddItem mstrDefGroup
        lstGroups.ListIndex = lstGroups.NewIndex
    Else
        lstGroups.ListIndex = iFolder
    End If
End Sub
Public Property Get GroupName(frm As Form, strDefGroup As String, Optional fPriv As Boolean = True, Optional ByVal fStart As Boolean = False) As String
    mstrDefGroup = strDefGroup
    Set mfrm = frm
    fPrivate = fPriv
    fStartMenu = fStart
    If gfNoUserInput = True Then
        mstrGroup = mstrDefGroup
        If Not fCreateProgGroup() Then
            ExitSetup frmSetup1, gintRET_FATAL
        End If
    Else
        Me.Show vbModal
    End If
    GroupName = mstrGroup
End Property
Private Sub txtGroup_GotFocus()
    txtGroup.SelStart = 0
    txtGroup.SelLength = 32767
End Sub